R Plotting Functions

Generate results for our CFR models

file_names_process <- c(
    "data/female_3to97.csv",
    "data/male_3to97.csv"
)

for(file_name in file_names_process){
  compute_cfr(file_name)
}

The following customised function can be used to visualise functional time series.

# A function used to save the created plots
savefig = function (filename, height=10, width = (1 + sqrt(5))/2*height, type=c("eps","pdf","jpg","png"), pointsize = 10, family = "Helvetica", sublines = 0, toplines = 0, leftlines = 0, res=300) 
{
    type <- match.arg(type)
    filename <- paste(filename, ".", type, sep = "")
    if(type=="eps")
    {
        postscript(file = filename, horizontal = FALSE, 
                width = width/2.54, height = height/2.54, pointsize = pointsize, 
                family = family, onefile = FALSE, print.it = FALSE)
    }
    else if(type=="pdf")
    {
        pdf(file = filename, width=width/2.54, height=height/2.54, pointsize=pointsize,
            family=family, onefile=TRUE)
    }
    else if(type=="jpg")
    {
        jpeg(filename=filename, width=width, height=height, res=res,quality=100, units="cm")#, pointsize=pointsize*50)
    }
    else if(type=="png")
    {
        png(filename=filename, width=width, height=height, res=res, units="cm")#, pointsize=pointsize*50)
    }
    else
        stop("Unknown file type")
    par(mgp = c(2.2, 0.45, 0), tcl = -0.4, mar = c(3.2 + sublines + 0.25 * (sublines > 0), 
         3.5 + leftlines, 1 + toplines, 1) + 0.1)
    par(pch = 1)
    invisible()
}

# A function wrapper used to save plots to PDF
savepdf = function(...)
{
    savefig(...,type="pdf")
}

# A customised function for visualising functional time series
functional_plot <- function(data_mat, age_range = 0:100, ub, lb, main, xlab, ylab, saveplot = c(TRUE, FALSE), plot_name)
{
  # data_mat in dimensions n x p
  nn = nrow(data_mat)
  np = ncol(data_mat)
  
  if(!is.null(age_range))
  {
    fts_obj = fts(x = age_range, y = data_mat)
  } else {
    fts_obj = fts(1:nn, data_mat)
  }
  
  if(saveplot)
  {
    savepdf(plot_name, width = 14, height = 10, toplines = 0.9, pointsize = 10)
    plot(x = fts_obj, plot.type = "functions", legend = FALSE, xlab = xlab, ylab = ylab, main = main, ylim = c(ub, lb))
    dev.off()
  } else {
    plot(x = fts_obj, plot.type = "functions", legend = FALSE, xlab = xlab, ylab = ylab, main = main, ylim = c(ub, lb))
  }
}

Plot CFR models as well as Hyndman baseline

file_names_compare <- c(
    "out/Tokyo_female_residuals.csv",
    "out/Tokyo_male_residuals.csv",
    "out/Tokyo_female_3to97_mf1_residuals.csv",
    "out/Tokyo_female_3to97_mf2_residuals.csv",
    "out/Tokyo_female_3to97_mf3_residuals.csv",
    "out/Tokyo_male_3to97_mm2_residuals.csv",
    "out/Tokyo_male_3to97_mm3_residuals.csv"
)

# Load required R functions
# install.packages("ftsa") # uncomment this line to install the package
library(ftsa)

## Loading required package: forecast

## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo

## Loading required package: rainbow

## Loading required package: MASS

## Loading required package: pcaPP

## Loading required package: sde

## Loading required package: stats4

## Loading required package: fda

## Loading required package: splines

## Loading required package: fds

## Loading required package: RCurl

## Loading required package: deSolve

## 
## Attaching package: 'fda'

## The following object is masked from 'package:forecast':
## 
##     fourier

## The following object is masked from 'package:graphics':
## 
##     matplot

## Loading required package: zoo

## 
## Attaching package: 'zoo'

## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric

## sde 2.0.18

## Companion package to the book

## 'Simulation and Inference for Stochastic Differential Equations With R Examples'

## Iacus, Springer NY, (2008)

## To check the errata corrige of the book, type vignette("sde.errata")

## 
## Attaching package: 'ftsa'

## The following objects are masked from 'package:stats':
## 
##     sd, var

# Both matrices have dimensions $101 \times 47$ ($p \times n$), where $n$ represents the number of functions observed at points $1, \ldots, p$. We need some R packages to make plots that show functions as continuous curves in rainbow colours, i.e., the distant past observations are shown in red and the recent observations are shown in purple. 

for(file_name in file_names_compare) {

    residual = read.csv(file_name, header = TRUE)

    title <- gsub(".csv", "", file_name)
    title <- gsub("out/", "plots/", title)

    print(title)

    functional_plot(data_mat = residual, age_range = 0:100, ub = 0.5, lb = -0.5, main = paste("Tokyo ", file_name), xlab = "Age", ylab = "Training Residuals", saveplot = TRUE, plot_name = title)
    functional_plot(data_mat = residual, age_range = 0:100, ub = 0.5, lb = -0.5, main = paste("Tokyo ", file_name), xlab = "Age", ylab = "Training Residuals", saveplot = FALSE)
}

## [1] "plots/Tokyo_female_residuals"

## [1] "plots/Tokyo_male_residuals"

## [1] "plots/Tokyo_female_3to97_mf1_residuals"

## [1] "plots/Tokyo_female_3to97_mf2_residuals"

## [1] "plots/Tokyo_female_3to97_mf3_residuals"

## [1] "plots/Tokyo_male_3to97_mm2_residuals"

## [1] "plots/Tokyo_male_3to97_mm3_residuals"